home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2gem106.lzh / CRYSTAL1.06 / SRC / TOOLBOX / SETOBJEC.MOD < prev    next >
Encoding:
Modula Implementation  |  1993-02-20  |  5.5 KB  |  277 lines
  1. IMPLEMENTATION MODULE SetObject;
  2.  
  3. (*
  4. Manipulating AES Object Structure.
  5.  
  6. UK __DATE__ __TIME__
  7. *)
  8.  
  9. (*IMP_SWITCHES*)
  10.  
  11. FROM RcMgr  IMPORT GRect,GPnt;
  12. FROM PORTAB IMPORT UNSIGNEDBYTE,SIGNEDWORD,UNSIGNEDWORD,WORDSET;
  13. CAST_IMPORT
  14.  
  15. IMPORT AES;
  16.  
  17. PROCEDURE Next(Tree : AES.TreePtr;
  18.                Index: AES.ObjectIndex;
  19.                Next : AES.ObjectPtr);
  20. BEGIN
  21. #if not UNIX
  22.   Tree^[Index].ObNext:= Next;
  23. #else
  24.  
  25. #endif
  26. END Next;
  27.  
  28. PROCEDURE Head(Tree : AES.TreePtr;
  29.                Index: AES.ObjectIndex;
  30.                Head : AES.ObjectPtr);
  31. BEGIN
  32. #if not UNIX
  33.   Tree^[Index].ObHead:= Head;
  34. #else
  35.  
  36. #endif
  37. END Head;
  38.  
  39. PROCEDURE Tail(Tree : AES.TreePtr;
  40.                Index: AES.ObjectIndex;
  41.                Tail : AES.ObjectPtr);
  42. BEGIN
  43. #if not UNIX
  44.   Tree^[Index].ObTail:= Tail;
  45. #else
  46.  
  47. #endif
  48. END Tail;
  49.  
  50. PROCEDURE Extnd(Tree : AES.TreePtr;
  51.                 Index: AES.ObjectIndex;
  52.                 Extnd: UNSIGNEDWORD);
  53. BEGIN
  54. #if not UNIX
  55. #if (defined LPRM2) || (defined SPCM2)
  56.   Tree^[Index].ObExtnd:= CHR(Extnd);
  57. #elif not packing
  58.   (* call once only *)
  59.   Tree^[Index].ObType:= CAST(UNSIGNEDWORD,CAST(WORDSET,Tree^[Index].ObType) + CAST(WORDSET,Extnd * 256));
  60. #else
  61.   Tree^[Index].ObExtnd:= CAST(UNSIGNEDBYTE,CHR(Extnd));
  62. #endif
  63. #else
  64.  
  65. #endif
  66. END Extnd;
  67.  
  68. PROCEDURE Type(Tree : AES.TreePtr;
  69.                Index: AES.ObjectIndex;
  70.                Type : AES.ObjectTypes);
  71. BEGIN
  72. #if not UNIX
  73. #if (defined MM2)
  74.   Tree^[Index].ObType:= CAST(UNSIGNEDBYTE,CHR(ORD(Type)));
  75. #elif not packing
  76.  Tree^[Index].ObType:= CAST(UNSIGNEDWORD,CAST(WORDSET,Tree^[Index].ObType) - CAST(WORDSET,000FFH));
  77.  Tree^[Index].ObType:= CAST(UNSIGNEDWORD,CAST(WORDSET,Tree^[Index].ObType) + CAST(WORDSET,ORD(Type)));
  78. #else
  79.   Tree^[Index].ObType:= Type;
  80. #endif
  81. #else
  82.  
  83. #endif
  84. END Type;
  85.  
  86. PROCEDURE Flags(Tree : AES.TreePtr;
  87.                 Index: AES.ObjectIndex;
  88.                 Flags: AES.ObjectFlag);
  89. BEGIN
  90. #if not UNIX
  91.   Tree^[Index].ObFlags:= Flags;
  92. #else
  93.  
  94. #endif
  95. END Flags;
  96.  
  97. PROCEDURE State(Tree : AES.TreePtr;
  98.                 Index: AES.ObjectIndex;
  99.                 State: AES.ObjectState);
  100. BEGIN
  101. #if not UNIX
  102.   Tree^[Index].ObState:= State;
  103. #else
  104.  
  105. #endif
  106. END State;
  107.  
  108. PROCEDURE Spec(Tree : AES.TreePtr;
  109.                Index: AES.ObjectIndex;
  110.                Info : AES.ObjectSpec);
  111.  
  112. BEGIN
  113. #if not UNIX
  114.   IF NOT(AES.Indirect IN Tree^[Index].ObFlags) THEN
  115.     Tree^[Index].ObSpec:= Info;
  116.   ELSE
  117.     Tree^[Index].ObSpec.Extension^.Spec:= Info;
  118.   END;
  119. #else
  120.  
  121. #endif
  122. END Spec;
  123.  
  124. PROCEDURE X(Tree : AES.TreePtr;
  125.             Index: AES.ObjectIndex;
  126.             XPos : SIGNEDWORD);
  127. BEGIN
  128. #if not UNIX
  129.   Tree^[Index].ObX:= XPos;
  130. #else
  131.  
  132. #endif
  133. END X;
  134.  
  135. PROCEDURE Y(Tree : AES.TreePtr;
  136.             Index: AES.ObjectIndex;
  137.             YPos : SIGNEDWORD);
  138. BEGIN
  139. #if not UNIX
  140.   Tree^[Index].ObY:= YPos;
  141. #else
  142.  
  143. #endif
  144. END Y;
  145.  
  146. PROCEDURE Width(Tree : AES.TreePtr;
  147.                 Index: AES.ObjectIndex;
  148.                 Width: SIGNEDWORD);
  149. BEGIN
  150. #if not UNIX
  151.   Tree^[Index].ObWidth:= Width;
  152. #else
  153.  
  154. #endif
  155. END Width;
  156.  
  157. PROCEDURE Height(Tree  : AES.TreePtr;
  158.                  Index : AES.ObjectIndex;
  159.                  Height: SIGNEDWORD);
  160. BEGIN
  161. #if not UNIX
  162.   Tree^[Index].ObHeight:= Height;
  163. #else
  164.  
  165. #endif
  166. END Height;
  167.  
  168. PROCEDURE Pnt(Tree : AES.TreePtr;
  169.               Index: AES.ObjectIndex;
  170.               Pos  : GPnt);
  171. BEGIN
  172. #if not UNIX
  173.   WITH Tree^[Index] DO
  174.     WITH Pos DO
  175.       ObX:= GX;
  176.       ObY:= GY;
  177.     END;
  178.   END;
  179. #else
  180.  
  181. #endif
  182. END Pnt;
  183.  
  184. PROCEDURE Rect(    Tree : AES.TreePtr;
  185.                    Index: AES.ObjectIndex;
  186.                VAR Rect : GRect);
  187.  
  188. BEGIN
  189. #if not UNIX
  190.   WITH Tree^[Index] DO
  191.     WITH Rect DO
  192.       ObX:= GX;
  193.       ObY:= GY;
  194.       ObWidth:= GW;
  195.       ObHeight:= GH;
  196.     END;
  197.   END;
  198. #else
  199.  
  200. #endif
  201. END Rect;
  202.  
  203. PROCEDURE StringPtr(Tree : AES.TreePtr;
  204.                     Index: AES.ObjectIndex;
  205.                     Ptr  : AES.StringPtr);
  206. BEGIN
  207. #if not UNIX
  208. #if (defined MM2)
  209.   CASE VAL(AES.ObjectTypes,ORD(Tree^[Index].ObType)) OF
  210. #elif not packing
  211.   CASE VAL(AES.ObjectTypes,Tree^[Index].ObType) OF
  212. #else
  213.   CASE Tree^[Index].ObType OF
  214. #endif
  215.     AES.GButton,AES.GString,AES.GTitle:
  216.       IF AES.Indirect IN Tree^[Index].ObFlags THEN
  217.         Tree^[Index].ObSpec.Extension^.Spec.String:= Ptr;
  218.       ELSE
  219.         Tree^[Index].ObSpec.String:= Ptr;
  220.       END;
  221.   | AES.GText,AES.GFText,AES.GBoxText,AES.GFBoxText:
  222.       IF AES.Indirect IN Tree^[Index].ObFlags THEN
  223.         Tree^[Index].ObSpec.Extension^.Spec.TextInfo^.TEPText:= Ptr;
  224.       ELSE
  225.         Tree^[Index].ObSpec.TextInfo^.TEPText:= Ptr;
  226.       END;
  227.   ELSE
  228.     ;
  229.   END;
  230. #else
  231.  
  232. #endif
  233. END StringPtr;
  234.  
  235. PROCEDURE String(    Tree : AES.TreePtr;
  236.                      Index: AES.ObjectIndex;
  237.                  VAR Str  : AES.String);
  238.  
  239. VAR i: AES.StringRange;
  240.  
  241. BEGIN
  242. #if not UNIX
  243. #if (defined MM2)
  244.   CASE VAL(AES.ObjectTypes,ORD(Tree^[Index].ObType)) OF
  245. #elif not packing
  246.   CASE VAL(AES.ObjectTypes,Tree^[Index].ObType) OF
  247. #else
  248.   CASE Tree^[Index].ObType OF
  249. #endif
  250.     AES.GButton,AES.GString,AES.GTitle:
  251.       WITH Tree^[Index].ObSpec DO
  252.         i:= 0;
  253.         REPEAT
  254.           String^[i]:= Str[i];
  255.           INC(i)
  256.         UNTIL Str[i] = 0C;
  257.         String^[i]:= 0C;
  258.       END;
  259.   | AES.GText,AES.GFText,AES.GBoxText,AES.GFBoxText:
  260.       WITH Tree^[Index].ObSpec.TextInfo^ DO
  261.         i:= 0;
  262.         REPEAT
  263.           TEPText^[i]:= Str[i];
  264.           INC(i)
  265.         UNTIL Str[i] = 0C;
  266.         TEPText^[i]:= 0C;
  267.      END;
  268.   ELSE
  269.     ;
  270.   END;
  271. #else
  272.  
  273. #endif
  274. END String;
  275.  
  276. END SetObject.
  277.